(define set-empty '())
(define (set-node l v r) (cons l (cons v (cons r '()))))
(define (set-left node) (car node))
(define (set-right node) (car (cdr (cdr node))))
(define (set-value node) (car (cdr node)))

(define (set-add t v)
  (if (null? t)
      (set-node set-empty v set-empty)
      (if (= v (set-value t))
          t
          (if (< v (set-value t))
              (set-node (set-add (set-left t) v) (set-value t) (set-right t))
              (set-node (set-left t) (set-value t) (set-add (set-right t) v))))))

(define (set-remove t v)
  (if (null? t)
      t
      (if (= v (set-value t))
          (if (if (null? (set-left t))
                  (null? (set-right t))
                  #f)
              '()
              (if (null? (set-left t))
                  (set-right t)
                  (if (null? (set-right t))
                      (set-left t)
                      (set-rotate (set-left t) (lambda (x) x) (set-right t)))))
          (if (< v (set-value t))
              (set-node (set-remove (set-left t) v) (set-value t) (set-right t))
              (set-node (set-left t) (set-value t) (set-remove (set-right t) v))))))

(define (set-rotate t parent tree-right)
  (if (null? (set-right t))
      (set-node (parent (set-left t)) (set-value t) tree-right)
      (set-rotate (set-right t) (lambda (hole) (parent (set-node (set-left t) (set-value t) hole))) tree-right)))

(define (set-contains? t v)
  (if (null? t)
      #f
      (if (= v (set-value t))
          #t
          (if (< v (set-value t))
              (set-contains? (set-left t) v)
              (if (> v (set-value t))
                  (set-contains? (set-right t) v)
                  #f)))))

(define (set->list-aux t m)
  (if (null? t)
      m
      (let* ((r (set->list-aux (set-right t) m))
             (c (cons (set-value t) r)))
        (set->list-aux (set-left t) c))))

(define (set->list t) (set->list-aux t '()))

(define (set-fold-aux fn t m)
  (if (null? t)
      m
      (let* ((l (set-fold-aux fn (set-left t) m))
             (c (fn l (set-value t))))
        (set-fold-aux fn (set-right t) c))))

(define (set-fold fn init t)
  (set-fold-aux fn t init))

(define (set-union a b)
  (set-fold (lambda (m c) (set-add m c)) a b))

(define (set-subtract a b)
  (set-fold (lambda (m c) (set-remove m c)) a b))

